VIBES STUDY 2 ANALYSIS — CHI REPORTING
ANONYMIZED
2024-08-07
In VISUALIZATION VIBES project Study 2, participants completed an attribution eliciation survey, asking questions about their social inferences drawn from (5) stimulus images (data visualizations). Each participant was randomly assigned to one of 6 stimulus blocks, each containing 1 image from each of (4) ‘embellishment categories’ (ranging from most abstract to most figural). Each participant started by responding to questions for a single ‘common’ stimulus (B0-0). Two participant recruitment pools were used: Prolific, with a smaller set of participants recruited from Tumblr (to replicate and compare survey results to Study 1 interviews with participants sourced from Tumblr).
This notebook contains code to replicate quantitative analysis of data from Study 2 reported in CHI submission #5584.
SETUP
Import Packages
Setup Graphing
# Custom ggplot theme to make pretty plots
# Get the font at https://fonts.google.com/specimen/Barlow+Semi+Condensed
theme_clean <- function() {
theme_minimal(base_family = "Barlow Semi Condensed") +
theme(panel.grid.minor = element_blank(),
plot.title = element_text(family = "BarlowSemiCondensed-Bold"),
axis.title = element_text(family = "BarlowSemiCondensed-Medium"),
strip.text = element_text(family = "BarlowSemiCondensed-Bold",
size = rel(1), hjust = 0),
strip.background = element_rect(fill = "grey80", color = NA))
}
set_theme(base = theme_clean())
############## SETUP Colour Palettes
#https://www.r-bloggers.com/2022/06/custom-colour-palettes-for-ggplot2/
## list of color pallettes
my_colors = list(
politics = c("#184aff","#5238bf", "#4f4a52" ,"#84649c", "#ff0000"),
blackred = c("black","red"),
greys = c("#707070","#999999","#C2C2C2"),
greens = c("#ADC69D","#81A06D","#567E39","#2D5D16","#193E0A"),
smallgreens = c("#ADC69D","#567E39","#193E0A"), ## MALE FEMALE OTHER
olives = c("#CDCEA1","#B8B979","#A0A054","#78783F","#50502A","#35351C"),
lightblues = c("#96C5D2","#61A2B2","#3C8093","#2C6378","#1F4A64"),
darkblues = c("#7AAFE1","#3787D2","#2A73B7","#225E96","#1A4974","#133453"),
reds = c("#D9B8BD","#CE98A2","#B17380","#954E5F","#78263E","#62151F"),
traffic = c("#CE98A2","#81A06D","yellow"),
questions = c("#B17380","#3787D2", "#567E39", "#EE897F"),
tools= c("#D55662","#EE897F","#F5D0AD","#A0B79B","#499678","#2D363A"), #? ... design.....vis...... programming
encounter = c("#8E8E8E","#729B7D"), ##SCROLL ENGAGE
actions2 = c("#8E8E8E","#729B7D"),
actions4 = c("#8E8E8E", "#A3A3A3","#729B7D","#499678"),
actions3 = c("#8E8E8E","#99b898ff","#fdcea8ff"),
actions = c("#8E8E8E","#2A363B","#99b898ff","#fdcea8ff","#ff837bff","#e84a60ff"),
platforms = c("#5D93EA","#FF70CD", "#3BD3F5", "#8B69B5","black"),
amy_gradient = c("#ac57aa", "#9e5fa4", "#90689f", "#827099", "#747894", "#66818e", "#578988", "#499183", "#3b997d", "#2da278", "#1faa72"),
my_favourite_colours = c("#702963", "#637029", "#296370")
)
## function for using palettes
my_palettes = function(name, n, all_palettes = my_colors, type = c("discrete","continuous"), direction = c("1","-1")) {
palette = all_palettes[[name]]
if (missing(n)) {
n = length(palette)
}
type = match.arg(type)
out = switch(type,
continuous = grDevices::colorRampPalette(palette)(n),
discrete = palette[1:n]
)
out = switch(direction,
"1" = out,
"-1" = palette[n:1])
structure(out, name = name, class = "palette")
}# ######## RETURNS SINGLE SD
# ## APPLY STYLE
plot_sd = function (data, column, type, mean, facet, facet_by, boxplot, labels) {
ggplot(data, aes(y = .data[[column]], x="")) +
{if(boxplot) geom_boxplot(width = 0.5) } +
geom_jitter(width = 0.1, alpha=0.2, {if(facet) aes(color=.data[[facet_by]])}) +
{if(mean)
stat_summary(fun="mean", geom="point", shape=20, size=5, color="blue", fill="blue")
} +
{if(mean)
## assumes data has been passed in with mean column at m
# stat_summary(fun="mean", geom="text", colour="blue", fontface = "bold",
# vjust=-1.25, hjust = 0.50, aes( label=round(..y.., digits=0)))
stat_summary(fun="mean", geom="text", colour="blue", fontface = "bold",
vjust=-1.25, hjust = 0.50, aes( label=round(..y.., digits=0)))
} +
{if(facet) facet_grid(.data[[facet_by]] ~ .)} +
# scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
{if(type == "S")
guides(
y = guide_axis_manual(labels = labels[column,"left"]),
y.sec = guide_axis_manual(labels = labels[column,"right"])
)} +
{if(type == "Q")
guides(
y = guide_axis_manual(labels = labels[q,"left"]),
y.sec = guide_axis_manual(labels = labels[q,"right"])
)} +
theme_minimal() +
labs (
caption = column
) + easy_remove_legend()
}Import References
############## IMPORT REFERENCE FILES
ref_stimuli <- readRDS("data/input/REFERENCE/ref_stimuli.rds")
# ref_surveys <- readRDS("data/input/REFERENCE/ref_surveys.rds")
ref_labels <- readRDS("data/input/REFERENCE/ref_labels.rds")
ref_labels_abs <- readRDS("data/input/REFERENCE/ref_labels_abs.rds")
############## SETUP Graph Labels
ref_stim_id <- levels(ref_stimuli$ID)
ref_cat_questions <- c("MAKER_ID","MAKER_AGE","MAKER_GENDER")
ref_free_response <- c("MAKER_DETAIL", "MAKER_EXPLAIN", "TOOL_DETAIL", "CHART_EXPLAIN")
ref_conf_questions <- c("MAKER_CONF", "AGE_CONF", "GENDER_CONF", "TOOL_CONF")
ref_sd_questions <- rownames(ref_labels)
ref_sd_questions_abs <- rownames(ref_labels_abs)
# ref_blocks <- c("block1", "block2", "block3", "block4", "block5", "block6")
ref_blocks <- c(1,2,3,4,5,6)Import Data
############## IMPORT DATA FILES
df_participants <- readRDS("data/output/df_participants.rds") #1 row per participant — demographic
df_graphs <- readRDS("data/output/df_graphs.rds") #only categorical and numeric questions
df_sd_questions_long <- readRDS("data/output/df_sd_questions_long.rds") # only sd questions LONGAGGREGATED DATA
(5.1.2) Survey Response Time
df <- df_participants
## for descriptives paragraph
a.desc.duration <- psych::describe(df %>% pull(duration.min))As Reported in Section 5.1.2 Procedure :
Across the entire sample, responses from (n = 318 ) participants ranged from 11 to 228 minutes, with a mean response time of 45 minutes, SD = 26.
rm(df, a.desc.duration)(5.1.4) Participants
df <- df_participants
## FOR DESCRIPTIVES PARAGRAPH
# #PROLIFIC
df.p <- df %>% filter(Distribution == "PROLIFIC")
desc.gender.p <- table(df.p$D_gender) %>% prop.table()
names(desc.gender.p) <- levels(df.p$D_gender)
p_participants <- nrow(df.p)
# #TUMBLR
df.t <- df %>% filter(Distribution == "TUMBLR")
desc.gender.t <- table(df.t$D_gender) %>% prop.table()
names(desc.gender.t) <- levels(df.t$D_gender)
t_participants <- nrow(df.t)As Reported in Section 5.1.4 Participants :
For Study 2, a total of 318 participants were recruited from US-located English speaking users of TUMBLR (n = 78) and PROLIFIC (n = 240).
78 individuals from Tumblr participated in Study 2, ( 36% Female, 5% Male, 40% Non-binary, 17% Prefer to Self Describe, 3% Prefer Not to Say. Other).
240 individuals from PROLIFIC participated in Study 2, ( 54% Female, 42% Male, 3% Non-binary, 0 % Prefer Not to Say, 0% Prefer to Self Describe).
rm(df, df.p, desc.gender.p, p_participants, df.t, desc.gender.t, t_participants)(5.1.4) Participants per Block
As Reported in Section 5.1.4 Participants, there were ~ 53 participants per stimulus block
df <- df_participants
table(df$Assigned.Block)##
## 1 2 3 4 5 6
## 55 52 52 54 53 52# cols = c("Block", "n")
# %>% kable(col.names = cols)(FIG 5) Survey Question Distributions
As Reported in Figure 5, descriptive statistics for in-scope survey questions.
# # library(tinytable)
# # library(webshot2)
#### CUSTOM HORIZONTAL STACKED BARPLOT
g <- function(d, ...){
p <- d$pal %>% unique
ggplot(d, aes(x="", fill=value)) +
geom_bar(stat="count", position = "stack") +
scale_fill_manual(values=my_colors[[p]]) +
coord_flip() + theme_void() + easy_remove_axes() + easy_remove_legend()
}
## SETUP LIST OF NUMERIC DATAFRAMES
all_q <- c("MAKER_CONF", "AGE_CONF", "GENDER_CONF", ref_sd_questions)
# ## SETUP NUMERIC DATAFRAME
df_num <- df_graphs %>% select(all_of(all_q))
## CALC MEANS
### MEANS
m <- sapply(df_num, FUN=mean)
m <- round(m,1)
m <- paste0("M=",m)
sd <- sapply(df_num, FUN=sd)
sd <- round(sd,1)
sd <- paste0("SD=",sd)
stat <- paste0(m," ",sd)
### CREATE LIST OF CATEGORICAL DATAFRAMES
id = df_graphs %>% select(MAKER_ID) %>%
pivot_longer(cols=1)%>% mutate(pal="reds") %>% as.data.frame()
age = df_graphs %>% select(MAKER_AGE) %>%
pivot_longer(cols=1)%>% mutate(pal="lightblues") %>% as.data.frame()
gender = df_graphs %>% select(MAKER_GENDER) %>%
pivot_longer(cols=1)%>% mutate(pal="smallgreens") %>% as.data.frame()
df_cat <- list()
df_cat[["MAKER_ID"]] <- id
df_cat[["MAKER_AGE"]] <- age
df_cat[["MAKER_GENDER"]] <- gender
## CALC CAT PROPORTIONS
n <- nrow(id)
m_id <- table(id) %>% as.data.frame() %>% mutate(prop = round(Freq/n, 2)*100) %>% map_df(rev) #reverse reading order
stat_id <- paste0(m_id$value, "(", m_id$prop,"%)") %>% unlist() %>% paste0(collapse=''," ")
n <- nrow(age)
m_age <- table(age) %>% as.data.frame() %>% mutate(prop = round(Freq/n, 2)*100)%>% map_df(rev)
stat_age <- paste0(m_age$value, "(", m_age$prop,"%)") %>% unlist() %>% paste0(collapse=''," ")
n <- nrow(gender)
m_gender <- table(gender) %>% as.data.frame() %>% mutate(prop = round(Freq/n, 2)*100)%>% map_df(rev)
stat_gender <- paste0(m_gender$value, "(", m_gender$prop,"%)")%>% unlist() %>% paste0(collapse=''," ")
## SETUP QUESTIONS
questions <- c(ref_cat_questions, "MAKER_CONF", "AGE_CONF", "GENDER_CONF", ref_sd_questions)
#### SETUP TABLE
tab <- data.frame(
VARIABLE = questions,
DISTRIBUTION = "",
STATISTICS = c(stat_id, stat_age, stat_gender, stat)
)
### RENDER TABLE
t <- tinytable::tt(tab, theme = "void") %>%
plot_tt(j=2, i= 1:3, fun=g, data = df_cat, height = 1.5) %>%
plot_tt(j=2, i= 4:17, fun="density", data = df_num, color="darkgrey") %>%
style_tt(j=2, align="c")
t| VARIABLE | DISTRIBUTION | STATISTICS |
|---|---|---|
| MAKER_ID |  |
political(16%) news(19%) business(20%) education(25%) organization(7%) individual(12%) |
| MAKER_AGE |  |
gen-z(9%) millennial(40%) gen-x(41%) boomer(10%) |
| MAKER_GENDER |  |
Male(59%) Female(34%) Other(7%) |
| MAKER_CONF |  |
M=61.6 SD=23.4 |
| AGE_CONF |  |
M=60 SD=21.3 |
| GENDER_CONF |  |
M=54.2 SD=25.4 |
| MAKER_DESIGN |  |
M=48.1 SD=28.3 |
| MAKER_DATA |  |
M=42.7 SD=27.7 |
| MAKER_POLITIC |  |
M=47 SD=18.7 |
| MAKER_ARGUE |  |
M=54.9 SD=19.9 |
| MAKER_SELF |  |
M=44 SD=19.6 |
| MAKER_ALIGN |  |
M=52.7 SD=18.1 |
| MAKER_TRUST |  |
M=58 SD=18.6 |
| CHART_TRUST |  |
M=54.6 SD=23.2 |
| CHART_INTENT |  |
M=41.3 SD=31.5 |
| CHART_LIKE |  |
M=48.6 SD=26.4 |
| CHART_BEAUTY |  |
M=49.5 SD=28.9 |
if(GRAPH_SAVE){
save_tt(t, output="figs/SUPPLEMENTALS/fig_5_descriptives.png", overwrite = TRUE)
}(FIG 6) Exploratory Factor Analysis
As Reported in Section 5.3, Figure 6, here we conduct an exploratory factor analysis of the semantic differential scale questions.
We use a parallel analysis method, verified by inspection of the scree plot to determine (4) factors, and see that both the KMO measure and Bartlett’s test of sphericity meet the necessary pre-requisites to support this analysis. The resultant factor loadings are described below.
jmv::efa(
data = df_graphs,
vars = as.vector(ref_sd_questions),
nFactors = 4,
extraction = "ml",
sortLoadings = TRUE,
screePlot = TRUE,
eigen = FALSE,
factorCor = TRUE,
factorSummary = FALSE,
modelFit = TRUE,
kmo = TRUE,
bartlett = TRUE)##
## EXPLORATORY FACTOR ANALYSIS
##
## Factor Loadings
## ──────────────────────────────────────────────────────────────────────────────────────
## 1 2 3 4 Uniqueness
## ──────────────────────────────────────────────────────────────────────────────────────
## MAKER_SELF -0.7918261 0.307250758
## MAKER_POLITIC -0.7076996 0.603427931
## MAKER_ALIGN 0.6892629 0.347261438
## MAKER_ARGUE 0.4176131 0.668728234
## CHART_LIKE 0.9085693 0.106804524
## CHART_BEAUTY 0.9016693 0.194798720
## CHART_TRUST 0.7026815 0.237539472
## CHART_INTENT -0.6191261 0.635219280
## MAKER_TRUST 0.3782844 0.5964198 0.259141681
## MAKER_DATA -0.5444486 0.3339561 0.627487467
## MAKER_DESIGN 0.9872773 0.004999614
## ──────────────────────────────────────────────────────────────────────────────────────
## Note. 'Maximum likelihood' extraction method was used in combination with a
## 'oblimin' rotation
##
##
## FACTOR STATISTICS
##
## Inter-Factor Correlations
## ───────────────────────────────────────────────────
## 1 2 3 4
## ───────────────────────────────────────────────────
## 1 — 0.4421002 0.4806922 -0.03897120
## 2 — 0.4396980 -0.35643200
## 3 — -0.14062620
## 4 —
## ───────────────────────────────────────────────────
##
##
## MODEL FIT
##
## Model Fit Measures
## ────────────────────────────────────────────────────────────────────────────────────────────────────
## RMSEA Lower Upper TLI BIC χ² df p
## ────────────────────────────────────────────────────────────────────────────────────────────────────
## 0.05604045 0.04584696 0.06679687 0.9665278 -23.41603 101.8993 17 < .0000001
## ────────────────────────────────────────────────────────────────────────────────────────────────────
##
##
## ASSUMPTION CHECKS
##
## Bartlett's Test of Sphericity
## ────────────────────────────────
## χ² df p
## ────────────────────────────────
## 8274.958 55 < .0000001
## ────────────────────────────────
##
##
## KMO Measure of Sampling Adequacy
## ────────────────────────────────
## MSA
## ────────────────────────────────
## Overall 0.8262260
## MAKER_DESIGN 0.6764995
## MAKER_DATA 0.7355368
## MAKER_POLITIC 0.8575518
## MAKER_ARGUE 0.9189571
## MAKER_SELF 0.8739272
## MAKER_ALIGN 0.8813865
## MAKER_TRUST 0.8696692
## CHART_TRUST 0.8682512
## CHART_INTENT 0.8381639
## CHART_LIKE 0.7665272
## CHART_BEAUTY 0.7189520
## ────────────────────────────────
BLOCK 2 DATA
(5.4) Design Features Index Social Attributions
As Reported in Section 5.4, here we visualize the semantic differential scale survey questions for each stimulus in randomization block #2
#DEFINE BLOCK 2 STIMULI
stimuli <- c("B2-1" ,"B2-2", "B2-3", "B2-4")
graphs <- list()
## LOOP THROUGH EACH STIMULUS IN LIST
i = 0
for (s in stimuli){
i = i+1
# setup titles
title <- ref_stimuli %>% filter(ID == s) %>% select(NAME) ##TODO IF NOT WORK ref_stim_id
title <- paste(s,"|",title)
# setup dataframe
df <- df_sd_questions_long %>% select(1:8, STIMULUS, QUESTION, STIMULUS_CATEGORY, value) %>% filter(STIMULUS == s)
d <- left_join( x = df, y = ref_labels,
by = c("QUESTION" = "ref_sd_questions")) %>%
mutate(
category=factor(category, levels=c("COMPETENCY","MAKER","CHART")),
QUESTION = factor(QUESTION, levels=ref_sd_questions)) %>%
group_by(QUESTION) %>%
mutate(m=median(value)) ## calc median for printing on graph
# GGDIST HALFEYE (raincloud doesn't work b/c long tails)
(g <- d %>%
ggplot(aes(y = fct_rev(QUESTION), x = value, fill=category)) +
stat_halfeye(scale=0.8, density="bounded", point_interval = "median_qi", normalize="xy") +
## MEDIAN
stat_summary(fun=median, geom="text", fontface = "bold", size= 2.2,
vjust=+2, hjust = 0.50, aes(label=round(m, digits=0)))+
stat_summary(fun=median, geom="point", size=2) +
scale_color_manual(values = my_palettes(name="greys", direction = "1"))+
scale_fill_manual(values = my_palettes(name="greys", direction = "1"))+
guides(
y = guide_axis_manual(labels = rev(ref_labels$left), title = ""),
y.sec = guide_axis_manual(labels = rev(ref_labels$right))
) +
cowplot::draw_text(text = ref_sd_questions, x = 90, y= ref_sd_questions,size = 8, vjust=-2) +
labs (title = title, y = "", caption = "(point is median)") +
theme_minimal() + easy_remove_legend()
)
graphs[[i]] <- g
if(GRAPH_SAVE == TRUE){
ggsave(plot = g, path="figs/SUPPLEMENTALS/", filename =paste0("fig_7_",s,"_ggdist.png"), units = c("in"), width = 10, height = 14,bg='#ffffff' )
}
} ## END LOOP
graphs## [[1]]
##
## [[2]]
##
## [[3]]
##
## [[4]]
PREDICTING TRUST
ADDITIONAL BLOCKS
In addition to the descriptive analysis of stimuli in Block 2 that is reported in the manuscript, here we create visualize the semantic differential scale for each stimulus in Study 2.
SD questions for each stimulus
#DEFINE STIMULI
df <- df_graphs
stimuli <- levels(df$STIMULUS)
graphs <- list()
## LOOP THROUGH EACH STIMULUS IN LIST
i = 0
for (s in stimuli){
i = i+1
# setup titles
title <- ref_stimuli %>% filter(ID == s) %>% select(NAME) ##TODO IF NOT WORK ref_stim_id
title <- paste(s,"|",title)
# setup dataframe
df <- df_sd_questions_long %>% select(1:8, STIMULUS, QUESTION, STIMULUS_CATEGORY, value) %>% filter(STIMULUS == s)
d <- left_join( x = df, y = ref_labels,
by = c("QUESTION" = "ref_sd_questions")) %>%
mutate(
category=factor(category, levels=c("COMPETENCY","MAKER","CHART")),
QUESTION = factor(QUESTION, levels=ref_sd_questions)) %>%
group_by(QUESTION) %>%
mutate(m=median(value)) ## calc median for printing on graph
# GGDIST HALFEYE (raincloud doesn't work b/c long tails)
(g <- d %>%
ggplot(aes(y = fct_rev(QUESTION), x = value, fill=category)) +
stat_halfeye(scale=0.8, density="bounded", point_interval = "median_qi", normalize="xy") +
## MEDIAN
stat_summary(fun=median, geom="text", fontface = "bold", size= 2.2,
vjust=+2, hjust = 0.50, aes(label=round(m, digits=0)))+
stat_summary(fun=median, geom="point", size=2) +
scale_color_manual(values = my_palettes(name="greys", direction = "1"))+
scale_fill_manual(values = my_palettes(name="greys", direction = "1"))+
guides(
y = guide_axis_manual(labels = rev(ref_labels$left), title = ""),
y.sec = guide_axis_manual(labels = rev(ref_labels$right))
) +
cowplot::draw_text(text = ref_sd_questions, x = 90, y= ref_sd_questions,size = 8, vjust=-2) +
labs (title = title, y = "", caption = "(point is median)") +
theme_minimal() + easy_remove_legend()
)
graphs[[i]] <- g
if(GRAPH_SAVE == TRUE){
ggsave(plot = g, path="figs/SUPPLEMENTALS/other_blocks/", filename =paste0(s,"_ggdist.png"), units = c("in"), width = 10, height = 14, bg='#ffffff' )}
} ## END LOOP
graphs## [[1]]
##
## [[2]]
##
## [[3]]
##
## [[4]]
##
## [[5]]
##
## [[6]]
##
## [[7]]
##
## [[8]]
##
## [[9]]
##
## [[10]]
##
## [[11]]
##
## [[12]]
##
## [[13]]
##
## [[14]]
##
## [[15]]
##
## [[16]]
##
## [[17]]
##
## [[18]]
##
## [[19]]
##
## [[20]]
##
## [[21]]
##
## [[22]]
##
## [[23]]
##
## [[24]]
##
## [[25]]
SESSION
sessionInfo()## R version 4.3.2 (2023-10-31)
## Platform: x86_64-apple-darwin20 (64-bit)
## Running under: macOS Sonoma 14.6.1
##
## Matrix products: default
## BLAS: /Library/Frameworks/R.framework/Versions/4.3-x86_64/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/4.3-x86_64/Resources/lib/libRlapack.dylib; LAPACK version 3.11.0
##
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
##
## time zone: America/New_York
## tzcode source: internal
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] rstatix_0.7.2 kSamples_1.2-10 SuppDists_1.1-9.7 jmv_2.5.6
## [5] lmerTest_3.1-3 lme4_1.1-35.1 Matrix_1.6-5 sjPlot_2.8.15
## [9] see_0.8.2 report_0.5.8 parameters_0.21.5 performance_0.10.9
## [13] modelbased_0.8.7 insight_0.19.9 effectsize_0.8.6 datawizard_0.9.1
## [17] correlation_0.8.4 bayestestR_0.13.2 easystats_0.7.0 jtools_2.2.2
## [21] tidygraph_1.3.1 interactions_1.2.0 paletteer_1.6.0 plotly_4.10.4
## [25] RColorBrewer_1.1-3 viridis_0.6.5 viridisLite_0.4.2 ggdist_3.3.2
## [29] patchwork_1.2.0 ggh4x_0.2.8 ggeasy_0.1.4 corrplot_0.94
## [33] GGally_2.2.1 gghalves_0.1.4 ggstatsplot_0.12.2 ggformula_0.12.0
## [37] ggridges_0.5.6 scales_1.3.0 qacBase_1.0.3 webshot2_0.1.1
## [41] tinytable_0.4.0 summarytools_1.0.1 magrittr_2.0.3 lubridate_1.9.3
## [45] forcats_1.0.0 stringr_1.5.1 dplyr_1.1.4 purrr_1.0.2
## [49] readr_2.1.5 tidyr_1.3.1 tibble_3.2.1 ggplot2_3.5.0
## [53] tidyverse_2.0.0 psych_2.4.1 Hmisc_5.1-2
##
## loaded via a namespace (and not attached):
## [1] splines_4.3.2 later_1.3.2 jmvcore_2.6.3
## [4] rpart_4.1.23 ggExtra_0.10.1 lifecycle_1.0.4
## [7] tcltk_4.3.2 processx_3.8.4 lattice_0.22-5
## [10] MASS_7.3-60.0.1 backports_1.4.1 sass_0.4.9
## [13] rmarkdown_2.26 jquerylib_0.1.4 yaml_2.3.8
## [16] httpuv_1.6.14 cowplot_1.1.3 minqa_1.2.6
## [19] chromote_0.3.1 abind_1.4-5 multcomp_1.4-26
## [22] nnet_7.3-19 TH.data_1.1-2 sandwich_3.1-1
## [25] labelled_2.12.0 codetools_0.2-19 tidyselect_1.2.1
## [28] farver_2.1.1 ggeffects_1.5.0 gmp_0.7-4
## [31] matrixStats_1.2.0 base64enc_0.1-3 jsonlite_1.8.8
## [34] ellipsis_0.3.2 Formula_1.2-5 survival_3.5-8
## [37] emmeans_1.10.0 systemfonts_1.0.6 BWStest_0.2.3
## [40] tools_4.3.2 ragg_1.3.0 pryr_0.1.6
## [43] PMCMRplus_1.9.10 Rcpp_1.0.12 glue_1.7.0
## [46] mnormt_2.1.1 gridExtra_2.3 xfun_0.42
## [49] distributional_0.4.0 websocket_1.4.2 numDeriv_2016.8-1.1
## [52] withr_3.0.0 fastmap_1.1.1 boot_1.3-30
## [55] fansi_1.0.6 digest_0.6.35 timechange_0.3.0
## [58] R6_2.5.1 mime_0.12 estimability_1.5
## [61] textshaping_0.3.7 colorspace_2.1-0 utf8_1.2.4
## [64] generics_0.1.3 data.table_1.15.2 httr_1.4.7
## [67] htmlwidgets_1.6.4 ggstats_0.5.1 pkgconfig_2.0.3
## [70] gtable_0.3.4 Rmpfr_0.9-5 statsExpressions_1.5.3
## [73] htmltools_0.5.7 carData_3.0-5 multcompView_0.1-10
## [76] snakecase_0.11.1 knitr_1.45 rstudioapi_0.15.0
## [79] tzdb_0.4.0 reshape2_1.4.4 nloptr_2.0.3
## [82] coda_0.19-4.1 checkmate_2.3.1 nlme_3.1-164
## [85] ggcorrplot_0.1.4.1 cachem_1.0.8 zoo_1.8-12
## [88] sjlabelled_1.2.0 parallel_4.3.2 miniUI_0.1.1.1
## [91] foreign_0.8-86 pillar_1.9.0 grid_4.3.2
## [94] vctrs_0.6.5 promises_1.2.1 car_3.1-2
## [97] xtable_1.8-4 cluster_2.1.6 GPArotation_2024.3-1
## [100] htmlTable_2.4.2 evaluate_0.23 zeallot_0.1.0
## [103] magick_2.8.3 mvtnorm_1.2-4 cli_3.6.2
## [106] compiler_4.3.2 rlang_1.1.3 crayon_1.5.2
## [109] labeling_0.4.3 modelr_0.1.11 rematch2_2.1.2
## [112] ps_1.7.6 sjmisc_2.8.9 plyr_1.8.9
## [115] stringi_1.8.3 pander_0.6.5 munsell_0.5.0
## [118] lazyeval_0.2.2 mosaicCore_0.9.4.0 sjstats_0.18.2
## [121] rapportools_1.1 hms_1.1.3 shiny_1.8.0
## [124] highr_0.10 haven_2.5.4 broom_1.0.5
## [127] igraph_2.0.3 memoise_2.0.1 bslib_0.6.1
(5.5) Social Inferences & Trust: Makers Matter
As reported in Section 5.5
What predicts CHART-TRUST? Recent work in psychology (Lin & Thorton, 2021) suggests that beauty is a strong predictor of trust. However, from our free response data, we have reason to believe the relationship is not this simple. For example, some participants explained that very aesthetically pleasing images were likely meant to be persuasive and thus were less trustworthy. Similarly, we observed that participants frequently talked about a maker’s data competency in relation to their trustworthiness. On this basis, we expect that in predicting
CHART_TRUST: (1) there will be a significant interaction betweenCHART_BEAUTYandCHART_INTENT, and (2) thatMAKER_DATA(competency) will also be a significant predictor.We test this hypothesis by fitting a series of linear mixed effects models, with
PID(participant unique identifier) as a random intercept to account for repeated measures. All continuous measures were originally taken on a (0-100) scale. In these models, all continuous predictors are first z-scored. We compare model fit via ChiSquared difference tests and likelihood ratio tests (for nested models).Setup Data
M1 | TRUST ~ BEAUTY
We begin by fitting a linear mixed effects, model predicting
CHART_TRUSTbyCHART_BEAUTYto see whether our data support the claims made by Lin & Thorton, 2021.(
CHART_TRUST0 = not at all untrustworthy, 100 = very trustworthy)(
CHART_BEAUTY0 = not at all aesthetically pleasing , 100 = very aesthetically pleasing)A model predicting
CHART-TRUSTbyCHART_BEAUTYexplains 30% variance inCHART_TRUST, with 22% variance explained by a significant main effect ofCHART_BEAUTY(\(t(1586) = 21.59, p < .001\)). The model coefficient indicates that for every 1 standard deviation increase inCHART-BEAUTY,CHART-TRUSTincreases on average by 0.47 SD.Model 1 supports the argument of Lin & Thorton (2021) that graphs judged to be more attractive are also judged as more trustworthy.
M2 | TRUST ~ BEAUTY + INTENT
Here we fit add a main effect term
CHART_INTENTas a predictor to the previous model and compare fit with Model 1, to determine whether a social attribution (in this case inference about the chart’s intent) is also predictive ofCHART_TRUST.(
CHART_TRUST0 = not at all untrustworthy, 100 = very trustworthy)(
CHART_BEAUTY0 = not at all aesthetically pleasing , 100 = very aesthetically pleasing)(
CHART_INTENT0 = to inform , 100 = persuade)A model predicting
CHART-TRUSTby a linear combination ofCHART_BEAUTYandCHART_INTENTexplains 49% variance inCHART_TRUST, with 41% variance explained by fixed effects alone:A significant main effect of
CHART_BEAUTY(\(t(1531) = 22.04, p <.001\)), andA significant main effect of
CHART_INTENT(\(t(1580) = -22.83, p <.001\)).The model coefficients indicates that for every 1 standard deviation increase in
CHART-BEAUTY,CHART-TRUSTincreases on average by 0.47 SD (more beauty corresponds to more trust). For every 1 standard deviation increase inCHART_INTENT, (where LOW values correspond to intent to INFORM and high values correspond to intent to PERSUADE)CHART-TRUSTdecreases by 0.44 SD (more persuasive corresponds to less trust).Further, model comparisons indicate that MODEL 2 (including
CHART_INTENT) is a significantly better fit to the data (\(\chi^2(1)=448 , p < 0.001\)) than MODEL 1 includingCHART_BEAUTYalone.Model 2 supports our claim that social attributions (in this case, an inference about the communicative intent of the chart) also predict beauty, above and beyond the beauty-centric argument of Lin & Thorton (2021) that graphs judged to be more attractive are also judged as more trustworthy.
M3 | TRUST ~ BEAUTY X INTENT
Here we fit a model with
CHART_INTENTas an interaction withCHART_BEAUTYand compare with the previous model to determine whether the social attribution ofCHART_INTENTmoderates the effect ofCHART_BEAUTYonCHART_TRUST.(
CHART_TRUST0 = not at all untrustworthy, 100 = very trustworthy)(
CHART_BEAUTY0 = not at all aesthetically pleasing , 100 = very aesthetically pleasing)(
CHART_INTENT0 = to inform , 100 = persuade)A model predicting
CHART-TRUSTby a linear interaction ofCHART_BEAUTYandCHART_INTENTexplains 51% variance inCHART_TRUST, with 42% variance explained by fixed effects alone:A significant main effect of
CHART_BEAUTY(\(t(1526) = 22.07, p <.001\))A significant main effect of
CHART_INTENT(\(t(1581) = -22.4, p <.001\))A significant interaction between
CHART_BEAUTYandCHART_INTENT(\(t(1559) = 7.01, p <.001\)).The model coefficients indicates that for every 1 standard deviation increase in
CHART-BEAUTY,CHART-TRUSTincreases on average by 0.47 SD (more beauty corresponds to more trust). For every 1 standard deviation increase inCHART_INTENT, (where LOW values correspond to intent to INFORM and high values correspond to intent to PERSUADE)CHART-TRUSTdecreases on average by 0.42 SD (more persuasive corresponds to less trust). The significant interaction term indicates the difference in slope between the two main effects, that is to say, that the effect ofCHART_BEAUTYonCHART_TRUSTis moderated such that the effect ofCHART_BEAUTYis minimized whenCHART_INTENTis attributed as more informative (lower values of chart_intent) than persuasive (higher values of chart_intent)Further, model comparisons indicate that MODEL 3 (an interaction rather than MODEL 2 with a linear combination of
CHART_BEAUTYandCHART_INTENT) is a significantly better fit to the data (\(\chi^2(1)=48.5 , p < 0.001\)).Model 3 supports our claim that social attributions (in this case, an inference about the communicative intent of the chart) also predict beauty, and infact can change (moderate) the effect of beauty on trust.
M4 | TRUST ~ BEAUTY X INTENT + MAKER_DATA
Here we add
MAKER_DATAcompetency to our previous model to determine whether a viewer’s inferences about the data analysis ability of the chart’s maker affect assesments of the chart’s trustworthiness.(
CHART_TRUST0 = not at all untrustworthy, 100 = very trustworthy)(
CHART_BEAUTY0 = not at all aesthetically pleasing , 100 = very aesthetically pleasing)(
CHART_INTENT0 = to inform , 100 = persuade)(
MAKER_DATA0 = professional in data analysis , 100 = layperson in data analysis)A model predicting
CHART-TRUSTby a linear interaction ofCHART_BEAUTYandCHART_INTENTas well as a main effect ofMAKER_DATAcompetency explains 54% variance inCHART_TRUST, with 45% variance explained by fixed effects alone:A significant main effect of
CHART_BEAUTY(\(t(1520) = 20.72, p <.001\)),A significant main effect of
CHART_INTENT(\(t(1580) = -18.81, p <.001\)),A significant main effect of
MAKER_DATA(\(t(1564) = -9.56, p <.001\)),A significant interaction between
CHART_BEAUTYandCHART_INTENT(\(t(1556) = 6.63, p <.001\)).The model coefficients indicates that for every 1 standard deviation increase in
MAKER_DATA,CHART-TRUSTdecreases on average by 0.19 SD (more layperson corresponds to less trust).For every 1 standard deviation increase inCHART-BEAUTY,CHART-TRUSTincreases on average by 0.38 SD (more beauty corresponds to more trust). For every 1 standard deviation increase inCHART_INTENT, (where LOW values correspond to intent to INFORM and high values correspond to intent to PERSUADE)CHART-TRUSTdecreases on average by 0.37 SD (more persuasive corresponds to less trust). The significant interaction term indicates the difference in slope between the two main effects, that is to say, that the effect ofCHART_BEAUTYonCHART_TRUSTis moderated such that the effect ofCHART_BEAUTYis minimized whenCHART_INTENTis attributed as more informative (lower values of chart_intent) than persuasive (higher values of chart_intent)Further, model comparisons indicate that MODEL 4 (adding a simple main effect of
MAKER_DATA) is a significantly better fit to the data than the prio model (\(\chi^2(1)=89.1 , p < 0.001\)) than MODEL 3 without theMAKER_DATAfixed effect.Model 4 supports our claim that social attributions (in this case, both an inference about the communicative intent of the chart and inference about the data analysis skill of the maker) also predict beauty, and infact can change (in the case of intent, moderate) the effect of beauty on trust.
(FIG 9) Predicting Trust